> module CHF.Transformation.Renamer where
> import CHF.Parse.Parser
> import CHF.CoreL.Language
> import Data.List
> import Debug.Trace
> import qualified Data.Map as Map


> renameAndClean :: Expr (Type ConsName) ConsName VarName
>                -> [String]
>                -> (Expr () String String, [String])

> renameAndClean e fv = let (a,b) = renameAC e (Map.empty) fv
>                       in (b,a)

> renameAC :: 
>                   Expr a ConsName VarName
>                   -> Map.Map String String
>                   -> [String]
>                   -> ([String], Expr b String String)

> renameAC (Var v) mp newnames = 
>  case Map.lookup (varName v) mp of
>    Just x -> (newnames,Var (x))
>    Nothing -> error $ "found free variable " ++ (varName v)

> renameAC (Lam v e) mp (n:newnames) = 
>   let (names',e') = renameAC e mp' newnames
>       mp' = Map.insert (varName v) n mp
>   in (names',Lam n e')
 
> renameAC (App e1 e2) mp (newnames) = 
>   let (names1,e1') = renameAC e1 mp newnames
>       (names2,e2') = renameAC e2 mp names1
>   in (names2,App e1' e2')

> renameAC (Seq e1 e2) mp (newnames) = 
>   let (names1,e1') = renameAC e1 mp newnames
>       (names2,e2') = renameAC e2 mp names1
>   in (names2,Seq e1' e2')

> renameAC (Cons (Left maction) args) mp newnames = 
>   let (names1,args') = renameACList args mp newnames
>   in (names1,(Cons (Left maction) args'))


> renameAC (Cons (Right cname) args) mp newnames = 
>   let (names1,args') = renameACList args mp newnames
>   in (names1,(Cons (Right (consName cname)) args'))

> renameAC (Case e1 alts) mp newnames = 
>   let (names1,e1') = renameAC e1 mp newnames
>       (names2,alts') = renameACAlts alts mp names1
>   in (names2, Case e1' alts')

> renameAC (Letrec binds e) mp newnames = 
>   let l = length binds
>       (bindvars,rhs) = unzip $  map (\(x :=: e) -> (x,e)) binds
>       (fresh,names') = splitAt l newnames
>       mp' = foldr (\(v1,v2) mpp -> Map.insert v1 v2 mpp) mp   (zip (map varName bindvars) fresh) 
>       (names'',newrhs) = renameACList rhs mp' names'
>       newbinds = zipWith (\a b -> a :=: b) fresh newrhs
>       (names''',e') = renameAC e mp' names'' 
>   in (names''',Letrec newbinds e')
> renameAC (Label lab expr) mp newnames =
>   renameAC expr mp newnames 

> renameACList []  mp newnames = (newnames,[])
> renameACList (a:args) mp newnames =
>  let (names1,a')    = (renameAC a mp newnames)
>      (names2,args') = renameACList (args) mp names1
>  in  (names2,a':args') 

> renameACAlts [] mp names = (names,[])
> renameACAlts (a:alts) mp names = 
>  let (names',a') = renameACAlt a mp names
>      (names'',alts') = renameACAlts alts mp names'
>  in (names'',a':alts')

> renameACAlt (CAlt cname vars e) mp names = 
>  let l = length vars
>      (fresh,names1) = splitAt l names
>      nmp = foldr (\(v1,v2) mpp -> Map.insert (varName v1) v2 mpp) mp (zip (vars) fresh)
>      (names2,e') = renameAC e nmp names1
>  in (names2,CAlt (consName cname) fresh e')



